COMMENT ⊗   VALID 00010 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	entry begin comment The extension module of TEX.
C00010 00003	internal procedure initext # do this when initializing TEX
C00011 00004	internal procedure extop # do this when "\x" sensed in user input
C00014 00005	internal procedure dumpext(integer p) # do this in procedure dumpnodelist
C00015 00006	internal procedure destroyext(integer p) # do this in procedure dsnodelist
C00016 00007	internal integer procedure copyext(integer p) # do this in procedure boxcopy
C00017 00008	internal procedure hpackext(integer p) # do this in procedure hpackage
C00018 00009	In houtext, x and y are coordinates of the reference point,
C00019 00010	internal procedure finishext # do this just before terminating TEX
C00020 ENDMK
C⊗;
entry; begin comment The extension module of TEX.

In order to extend TEX without changing other modules, you can supply
procedures for the "hooks" internal to this module. Most of these procedures
are called when TEX's routines come up with a case that is ordinarily
undefined (usually when processing a node of type "whatsit").

Whatsit nodes can have variable length. The value field of the first word
of a whatsit should identify what kind of whatsit it is. In the
present extension module the types used are:
	0	used for \send
IFPARC	1	for elementary operations of color printing (by L. Guibas) ENDPARC

The "send" routines are based on code developed by Jim Boyce. They appear in
this module because they were the first trial extensions to TEX, although
they are now considered to be "primitives";

require "TEXHDR.SAI" source_file;

internaldef sendnodesize=2 # number of words to allocate for a send node;
internaldef sendstream(p)=⊂value(p+1)⊃ # stream number for tokens to be sent;
internaldef sendtoks(p)=⊂link(p+1)⊃ # token list to be sent;
internal saf integer array sendout["0":"9"] # channel numbers for output streams;
internal boolean firstonpage # no sends to terminal yet on this output page;
IFPARC
comment Warning: these definitions shared among TEXPRS and TEXHDR!!;
internal boolean color;
internal integer curbrightness, curhue, cursaturation;
integer oldbrightness, oldhue, oldsaturation;
define brightness=0, hue=1, saturation=2;
define colornodesize=2 # number of words to allocate for a color node;
define colorwhatsit=1 # type code for color whatsits;
define colorcmd(p)=⊂((mem[p+1] lsh -8) land '3)⊃;
define colorval(p)=⊂(mem[p+1] land '377)⊃;

internal boolean nextfonteightbit;
ENDPARC

internal procedure whatsitappend(integer p) # appends node p to the current list;
begin comment This is somewhat like "simpleappend" in TEXSEM p19;
integer q;
if abs(mode)≠mmode then q←p else
	begin comment In math mode, append a "nodenoad";
	getavail(q); mem[q]←(nodenoad lsh typed)+(p lsh valued);
	end;
mem[curnode]←mem[curnode]+q; curnode←q;
end;

procedure sendit(integer p) # sends token list to the output stream;
begin integer chan,token,tlist; if mem[p+1]=0 then return # already sent;
chan←sendout[sendstream(p)]; tlist←sendtoks(p);
getavail(token); mem[token]←((rbrace lsh cmdd)+"}") lsh infod; inslist(token);
insrclist(tlist); delrclink(tlist);
getavail(token); mem[token]←((lbrace lsh cmdd)+"{") lsh infod; inslist(token);
comment We have prepared to run "{<toklist>}" thru TEX's scanner, as if
	scanning an \xdef;
mem[p+1]←0; curcmd←def; hashentry←hashsend; tlist←scantoks;
poptokenlist # remove "}" from input stack;
dumplist(link(tlist),0); dslist(tlist);
if chan<0 then 
	begin if firstonpage then print(nextline);
	print(tokstring[0],nextline);
	firstonpage←false;
	end
else	begin
	ifc SUAI or MIT thenc integer i,l; l←length(tokstring[0]);
	while l≥150 do
		begin comment We will break up the long line so TEX can read it;
		i←60;
		while i≤l and tokstring[0][i for 1]≠" " do i←i+1;
		if i≥150 then done # no way found, just leave it unbroken;
		out(chan,tokstring[0][1 to i-1]);
		if tokstring[0][i-1 for 1]=escapechar then out(chan," ");
		out(chan,nextline);
		l←l-i; tokstring[0]←tokstring[0][i+1 to ∞];
		end;
	endc
	out(chan,tokstring[0]); out(chan,nextline);
	end;
end;

internal procedure initext # do this when initializing TEX;
begin integer d;
for d←"0" thru "9" do sendout[d]←-1 # all \send channels are closed;
IFPARC curbrightness←0; oldbrightness←0; curhue←0; oldhue←0;
cursaturation←0; oldsaturation←0;
color←false;
nextfonteightbit←false; ENDPARC
end;

internal procedure extop # do this when "\x" sensed in user input;
begin label unknown;
ifc PARC thenc integer octal, i, p;
do getnctok until curcmd ≠ spacer; backinput;
if scanstring("color") then color←true
else if scanstring("nocolor") then color←false
else if scanstring("eightbit") then nextfonteightbit←true
else if color then
	begin
	p←getnode(colornodesize);
	mem[p]←(whatsitnode lsh typed)+(colorwhatsit lsh valued);
	octal←0;
	if scanstring("brightness") then
		begin
		mem[p+1]←brightness lsh 8;
		for i ← 1 thru 3 do octal←8*octal+scandigit-"0";
		if octal > '377 then octal←curbrightness←oldbrightness
		else begin oldbrightness←curbrightness; curbrightness←octal; end;
		end
	else if scanstring("hue") then
		begin
		mem[p+1]←hue lsh 8;
		for i ← 1 thru 3 do octal←8*octal+scandigit-"0";
		if octal > '377 then octal←curhue←oldhue
		else begin oldhue←curhue; curhue←octal; end;
		end
	else if scanstring("saturation") then
		begin
		mem[p+1]←saturation lsh 8;
		for i ← 1 thru 3 do octal←8*octal+scandigit-"0";
		if octal > '377 then octal←cursaturation←oldsaturation
		else begin oldsaturation←cursaturation; cursaturation←octal; end;
		end
	else error("Unrecognized extension to TEX");
	mem[p+1]←mem[p+1]+(octal land '377);
	whatsitappend(p);
	end;
elsec
unknown: error("Unrecognized extension to TEX");
endc
end;

internal procedure dumpext(integer p) # do this in procedure dumpnodelist;
case value(p) of begin
[0] if mem[p+1] then begin comment \send;
string s; dumplist(link(sendtoks(p)),0); s←tokstring[0];
if length(s)>30 then s←s[1 to 30]&"...\ETC";
print("\send ",sendstream(p)&"{",s,"}") end else print("\sent");
IFPARC
[colorwhatsit] case colorcmd(p) of begin
	[brightness] print("\x brightness '"&cvos(colorval(p)));
	[hue] print("\x hue '"&cvos(colorval(p)));
	[saturation] print("\x saturation '"&cvos(colorval(p)));
	else confusion
	  end;
ENDPARC
else print("whatsit?!")
  end;

internal procedure destroyext(integer p) # do this in procedure dsnodelist;
case value(p) of begin
[0] begin if mem[p+1] then delrclink(sendtoks(p)); freenode(p,sendnodesize) end;
IFPARC [colorwhatsit] freenode(p,colornodesize); ENDPARC
else errorstop("Dry rot--bad extension [unknown case in destroyext]")
  end;

internal integer procedure copyext(integer p) # do this in procedure boxcopy;
begin integer r;
case value(p) of begin
[0] begin integer q; r←getnode(sendnodesize); mem[r]←whatsitnode lsh typed;
mem[r+1]←mem[p+1]; q←sendtoks(r); if q then mem[q]←mem[q]+refct1 end;
IFPARC
[colorwhatsit] begin r←getnode(colornodesize); mem[r+1]←mem[p+1];
mem[r]←(whatsitnode lsh typed)+(colorwhatsit lsh valued) end;
ENDPARC
else errorstop("Dry rot--bad extension [unknown case in copyext]")
  end;
return(r);
end;

internal procedure hpackext(integer p) # do this in procedure hpackage;
;

internal procedure vpackext(integer p) # do this in procedure vpackage;
;

internal procedure pageext(integer p) # do this in the addtopage routine;
;

internal procedure justext(integer p) # do this in the justification routine;
;

comment In houtext, x and y are coordinates of the reference point,
while in voutext they are coordinates of the upper left corner;

internal procedure houtext(integer p; reference real x,y) # do this in shipout;
case value(p) of begin
[0] sendit(p);
IFPARC [colorwhatsit] if color then PutColor(colorcmd(p),colorval(p)); ENDPARC
else comment do nothing;
  end;

internal procedure voutext(integer p; reference real x,y) # do this in shipout;
case value(p) of begin
[0] sendit(p);
IFPARC [colorwhatsit] if color then PutColor(colorcmd(p),colorval(p)); ENDPARC
else comment do nothing;
  end;

internal procedure finishext # do this just before terminating TEX;
begin integer d;
for d←"0" thru "9" do
	begin if sendout[d]≥0 then release(sendout[d]);
	end;
end;
end